COMMENT ⊗   VALID 00007 PAGES VERSION 16-2(11)
RECORD PAGE   DESCRIPTION
 00001 00001
 00002 00002	HISTORY
 00004 00003	Comser Data -- Povtab, Dsplin stuff
 00006 00004	Strngc Supply Routines for Compiler Structures
 00008 00005	Compiler-Specific portion of Error UUO stuff
 00010 00006	Dsplin Routine for Displaying Input Line
 00015 00007	Interrupt Handler -- Intrpt, Povtrp
 00018 ENDMK
⊗;
COMMENT ⊗HISTORY
AUTHOR,REASON
021  202000000013  ⊗;


COMMENT ⊗
VERSION 16-2(11) 3-13-73 BY JRL REMOVE REFERENCES TO GAG
VERSION 16-2(10) 7-3-72 BY DCS INSTALL VERSION 16
VERSION 15-2(9) 2-26-72 BY DCS <ESC> I ALWAYS BREAKS
VERSION 15-2(8) 2-6-72 BY DCS BUG #GM# RETURN ADDRESS BEING WIPED OUT IN POVTRP
VERSION 15-2(7) 2-5-72 BY DCS BUG #GJ# ADD LSTON LISTING CONTROL STUFF
VERSION 15-2(6) 2-1-72 BY DCS BUG #GH# <ESC>I CAUSES PARSER TO BREAK AFTER NEXT SCAN
VERSION 15-2(5) 12-26-71 BY DCS BUG #FU# REENABLE ACCESS TO FTDEBUG FROM ERR UUO
VERSION 15-2(4) 12-22-71 BY DCS BUG #FT# DSPLIN CLEANED UP
VERSION 15-2(3) 12-22-71 BY DCS BUG #FT# MYERR RETURNS BINLIN (SEQUENTIAL LINE #)
VERSION 15-2(2) 12-21-71 BY DCS BUG #FS# REMOVE COM2 REFS (ASSUME RUNTIM OR LIB)
VERSION 15-2(1) 12-2-71 BY DCS INSTALL VERSION NUMBER

⊗;
COMMENT ⊗Comser Data -- Povtab, Dsplin stuff⊗
	LSTON	(COMSER)

BEGIN COMSER		;SERVICE ROUTINES FOR COMPILER.

ZERODATA (COMSER VARIABLES)

COMMENT ⊗
POVTAB -- table of ASCIZ strings, one per AC, giving reasonable
    messages to be typed when PDL overflow occurs. 0 if none
    provided -- set up in POVSET from SAIL INIT -- changed 
    occasionally as needs change.  Used by POVTRP below
⊗
↑↑POVTAB: BLOCK  10

;PDLSV, PDLSV1 -- save AC's when PDL trapping
↓PDLSV: 0
↓PDLSV1:0

DATA (COMSER VARIABLES)

COMMENT ⊗
DSPLIN and MYERR variables
⊗
NOEXPO <
OFFRAID:	.+2
	0
	0
DPYPRG:		0
	AIVECT -=512,=50
>;NOEXPO

DLINBF:	BLOCK 53

↑STODPY←DLINBF+52
ENDDBF←DLINBF+53

NOEXPO <
DPYBLK:	DPYPRG
	ENDDBF-DPYPRG
>;NOEXPO
ENDDATA
COMMENT ⊗Strngc Supply Routines for Compiler Structures⊗

;          →→→→→→ SORT THE STRINGS IN SYMBOL TABLE ←←←←←←

DSCR RINGSORT
CAL PUSHJ from STRINGC.
DES It passes off to the GC all of the Strings located in
  symbol table Semblks in the compiler. It does this by
  searching down the %RSTR ring (STRRNG).
⊗

T←←11

↑RINGSORT:
	HRRZ	T,STRRNG	;→LAST BLOCK IN STRING RING
	JUMPE	T,CPOPJ		;DONE WHEN 0, GO MARK VARIABLES
RGSLUP:	MOVEI	A,$PNAME(T)	;→DESCRIPTOR
	PUSHJ	P,@-1(P)	;SORT IT INTO LISTS
	HLRZ	T,%RSTR(T)	;NEXT BLOCK
	JUMPN	T,RGSLUP	;CONTINUE UNLESS DONE

;	   →→→→→→ SORT STRINGS IN DEFINE STACK ←←←←←←
DSCR DEFSRT
CAL PUSHJ from STRINGC
DES Passes off all Strings currently in the Define stack to be collected.
⊗;

↑DEFSRT:
	HRRZ	A,DFSTRT	;SORT STRINGS ON DEFINE STACK
	HRRZ	T,DEFPDP	;TERMINATION VALUE
	SUBI	A,1		;INIT
	JRST	SGDTST		;JUMP INTO THINGS

DEFMRK:	
	PUSHJ	P,@-1(P)	;SORT INTO STRUCTURE
SGDTST:
	ADDI	A,2		;AUTO-INCR DOESN'T GO FAR ENOUGH
	CAMGE	A,T		;DONE?
	JRST	DEFMRK		; NO
	POPJ	P,		; YES


	RINGSORT		;1 ROUTINE
	0
	LINK 4,.-1		;FOR STRING GARBAGE COLL.

	DEFSRT
	0
	LINK 4,.-1		;AND ANOTHER ROUTINE.


COMMENT ⊗Compiler-Specific portion of Error UUO stuff⊗

DSCR MYERR
DES Part of the second segment kludge -- so that the error
  handler can call some routines which are specific to the
  compiler. There routines are -- display the current line.
  -- call the editor on the current input file.
⊗;
IFN FTDEBUG,<
	INNA			;FR0M ERR -- TO LOOK AT STACK
;>	0			;NO DEBUGGER
↑↑MYERR:
	MOVE	13,SRCFIL	;FILE NAME NEEDED IN ANY CASE
	MOVE	16,FPAGNO	;AS IS THIS
	CAIE	A,1		;IS THIS A REQUEST FOR AN EDIT??
	 JRST	 NOE
	MOVE	14,SRCEXT
	MOVE	11,SRCPPN
	SKIPN	15,ASCLIN
	MOVE	15,[ASCID/00000/]
	TRO	15,1		;FOR WFW
	MOVE	12,BINLIN	;TV WILL WANT THIS NUMBER INSTEAD
	POPJ	P,		;RETURN WITH REGISTERS SET UP.
NOE:	PUSHJ	P,DSPLIN
	JFCL			;DON'T CARE HOW YOU DO IT
	POPJ	P,
COMMENT ⊗Dsplin Routine for Displaying Input Line⊗

DSCR DSPLIN
PAR Line specs from compiler, DPYSW (indicates DPY or TTY)
CAL PUSHJ
RES DPYSW on (less than 0) -- print line displayed, no-skip return
 DPYSW off -- no action, skip-return
SID changes A,B,C,TEMP
DES compiler only -- displays current input line, file and page # on
 piece of glass # 1
⊗

↑DSPLIN: 
	AOS	(P)	;ASSUME NO DISPLAY, SKIP RETURN
NOEXPO <
	MOVEI	TEMP,1
	MOVEM	TEMP,DLINBF	;
>;NOEXPO
EXPO <
	SETZM	DLINBF
>;EXPO
	MOVE	TEMP,[XWD DLINBF,DLINBF+1]
	BLT	TEMP,ENDDBF-1	;MAKE ALL DISPLAY BUFFER ASCID
	PUSH	P,PNEXTC	;SAVE BECAUSE MIGHT GRONK
	SKIPN	LSTCHR
	JRST	NOBAK
	REPEAT 4,<IBP PNEXTC
>
	SOS	PNEXTC
NOBAK:	PUSH	P,12		;SAVE TEMPORARILY
	PUSH	P,B
	MOVE	12,[POINT 7,DLINBF] ;OUTPUT POINTER, PRINSYM WANTS HERE
	MOVE	A,SRCFIL	;PRINT FILE NAME
	PUSHJ	P,PRINSYM	;WITH THIS ROUT
	MOVE	TEMP,12		;OUTPUT HERE FROM NOW ON
	POP	P,B
	POP	P,12
	MOVE	D,FPAGNO
	SETZM	BKR		;DENOTE 0 AS BREAK CHAR
	MOVE	A,[POINT 7,[ASCII /, PAGE /]]
	PUSHJ	P,ASCFIL	;TELL HIM WHAT IT IS
	PUSHJ	P,DECFIL	;STUFF PAGE NUM IN BUFFER
	MOVE	A,[POINT 7,[<BYTE (7) 15,12>]] ;MAKE SPACE
	PUSHJ	P,ASCFIL
	SETOM	BKR		;BREAK ON 0, 177, OR 12
	MOVE	A,[POINT 7,ASCLIN] ;PREPARE TO OUTPUT LINE NO.
	SKIPE	(A)
	PUSHJ	P,ASCFIL	;DO IT
	MOVE	A,[POINT 7,[ASCII /   /]]
	PUSHJ	P,ASCFIL
	MOVE	C,SCNWRD	;GET LIST CONTROL BITS
	TLNN	C,4000		;IN A MACRO?
	JRST	NOMAC		;NO
	HRRZ	C,DFSTRT
	MOVE	C,2(C)		;PNEXTC AT THAT TIME
	MOVEM	C,FILBP		;ARROW CONTROL
	MOVE	A,IPLINE	;WHERE IT ALL BEGAN
	PUSHJ	P,ASCFIL	;DO THE LINE
	SETZM	BKR		;TEMP
	MOVE	A,[POINT 7,[BYTE (7) 15,12,12]]
	PUSHJ	P,ASCFIL	;GO TO NEXT LINE
	SETOM	BKR
	MOVE	A,[POINT 7,[ASCIZ /        /]]
	SKIPE	ASCLIN		;IF PUT OUT LINE BEFORE,
	PUSHJ	P,ASCFIL	;MATCH IT
NOMAC:	MOVE	C,PNEXTC	;SAME FOR CURRENT LINE
	MOVEM	C,FILBP
	MOVE	A,PLINE
	PUSHJ	P,ASCFIL
	SETZM	FILBP		;PRECAUTION
NOEXPO <
	SKIPL	DPYSW
	 JRST	 [ 
>;NOEXPO
		 TERPRI
		  MOVEI A,0
		  IDPB A,TEMP
		  TTCALL 3,DLINBF
NOEXPO <
		  JRST   POPOP]
	DPYOUT	17,OFFRAID ;TURN OFF RAID IF ON
	MOVE	B,[DPYJMP DPYPRG] ;DPYJMP TO START
	MOVEM	B,1(TEMP)	;TO END OF BUFFER
	DPYSIZ	(2,5)
	DPYPOS	(-=100)
	DPYOUT	1,DPYBLK
	SOS	-1(P)
>;NOEXPO
POPOP:	POP	P,PNEXTC	;GET REAL ONE BACK
	POPJ	P,

↑PRSYM:	PUSH	P,C
	HRRZ	B,$PNAME(LPSA)		;PRINT SYMBOL IN LPSA
	MOVE	A,$PNAME+1(LPSA)
	JRST	PRTST
PRLOP:	ILDB	C,A			;GET CHAR.
	TTCALL	1,C			;PRINT IT.
PRTST:	SOJGE	B,PRLOP
	TERPRI
	POP	P,C
	POPJ	P,

↑CORERR:ERR	<NO CORE AVAILABLE>

↑DSPCLR: SKIPE	DPYSW		;IF ON A DISPLAY
	DPYCLR			;CLEAR
	POPJ	P,
COMMENT ⊗Interrupt Handler -- Intrpt, Povtrp⊗

DSCR POVTRP
CAL SYSTEM INTERRUPT
PAR JOBTPC is 1 past bad instr.
RES POVTAB(offending AC) is inspected for a string address.
  If it is there, the string is TTYOUTed as an error, indicating
  to the user which PDL oved. This is a fatal error message.
  Continuation is in general quite futile.
⊗

;;#GH# DCS 2-1-72 (5-5) <ESC>I CAUSES PARSER TO BREAK AFTER NEXT SCAN
↑INTRPT:
NOEXPO <
IFN FTDEBUG, <
	MOVE	TEMP,JOBCNI	;REASON
	TLNN	TEMP,INTTTI	;<ESC> I?
	 JRST	 POVDO		; NO, PDL OV
	MOVE	TEMP,[XWD 400000,377777];INTERRUPT INDICATION
	SETZM	MULTP		;NOT IN MULTIPLE-PROCEED,
	MOVEM	  TEMP,.DBG.	;  IT IS GOING TO STOP
	CALL6	DISMIS
POVDO:
>;IFN FTDEBUG
	CALL6	(UWAIT)		;GET OUT OF MONITOR MODE, GET ACS
	CALL6	(DEBREAK)	;"JRST" .+1
>;NOEXPO
;;#GH# (5-5)
↑POVTRP: MOVEM	TEMP,PDLSV	;SAVE ACS
	MOVEM	LPSA,PDLSV1
;;#GM# DCS 2-6-72 (1-1) WAS WIPING OUT TEMP WITH MOVEW
	MOVE	LPSA,GOGTAB	;NOW RECORD WHERE IT HAPPENED FOR ERR MSG
	MOVEW	UUO1(LPSA),JOBTPC
;;#GM# (1-1) TEMP STILL HOLDS JOBTPC
	LDB	TEMP,[POINT 4,-1(TEMP),12] ;HOW DID IT HAPPEN?
	ADDI	TEMP,17		;ADJUSTMENT
	ANDI	TEMP,17
	ROT	TEMP,-1		;GET INDEX TO HALF-WORDS, LOW BIT TO SIGN
	HRRZ	LPSA,POVTAB(TEMP) ;ASSUME ODD -- RIGHT HAND
	JUMPL	TEMP,.+2	;CORRECT
	HLRZ	LPSA,POVTAB(TEMP);EVEN -- WRONG
	JUMPN	LPSA,.+2	;WAS THERE A CLUE?
	MOVEI	LPSA,[ASCIZ /UNKNOWN STACK/]
	PRINT	<PUSH-DOWN OVERFLOW -- >	;TELL HIM SOME
	MOVE	TEMP,PDLSV
	EXCH	LPSA,PDLSV1		;RESTORE ACS
	ERR.	@PDLSV1			;TELL HIM MORE
	JRST	2,@JOBTPC		;IF HE SOMEHOW CONTINUES
BEND

	USE	ZVBLS
↑ZZZ←←.
	USE	VBLS
↑VVV←←.
	USE
↑↑ZHI:	ZZZ
↑↑VHI:	VVV
BEND	SAIL		;WOW
	PATCH:	BLOCK 50
	VAR
	XLIST
	END	START